home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
cutpas12.zip
/
CUT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-05
|
3KB
|
150 lines
program Cut_File;
USES Rline;
TYPE
RFtester = Object(RFextended)
PROCEDURE CheckRFerror; virtual;
END;
PROCEDURE RFtester.CheckRFerror;
{ Displays some of the common errors, and waits for a keypress. }
BEGIN
IF (RFerror = 0)or(RFerror = $FFFF) then exit;
WriteLn(RFerrorString);
END;
const beep:char=#7;
inpbufsize=24*1024;
outpbufsize=18*1024;
var s,inp,outp,outp1,outp2:string;
inpf:rftester;
outpf1,outpf2:text;
inpb:array[1..inpbufsize] of char;
outpb1,outpb2:array[1..outpbufsize] of char;
len:integer;
procedure read_parameter;
var code:integer;
function open_file:boolean;
{ Apre un file e ritorna il valore
FALSE se si e' verificato un errore }
var err:boolean;
begin
inpf.Init(inp, inpbufsize, inpb); { try to open the file. }
inpf.CheckRFerror;
err:=(inpf.RFerror<>0);
if err then writeln('Error opening ',inp,'!',beep);
open_file:=not(Err);
end;
function create_file:boolean;
var err:boolean;
begin
code:=pos('.',outp);
if code<>0 then begin
outp1:=copy(outp,1,code)+'LFT';
outp2:=copy(outp,1,code)+'RGT';
end else begin
outp1:=outp+'.LFT';
outp2:=outp+'.RGT';
end;
assign(outpf1,outp1);
(*$i-*)
rewrite(outpf1);
(*$i+*)
err:=(ioresult<>0);
if err then writeln('Error creating ',inp,'!',beep) else begin
settextbuf(outpf1,outpb1);
assign(outpf2,outp2);
(*$i-*)
rewrite(outpf2);
(*$i+*)
err:=(ioresult<>0);
if err then begin
close(outpf1);
erase(outpf1);
writeln('Error creating ',inp,'!',beep);
end else settextbuf(outpf2,outpb2);
end;
create_file:=not(err);
end;
begin
inp:=paramstr(2);
while (not(open_file)) do begin
write('Input File Name (with extension) : ');
readln(inp);
end;
outp:=inp;
while(not(create_file)) do begin
write('Output File Name (without extension) : ');
readln(outp);
end;
val(paramstr(1),len,code);
while ((code<>0) or (len=0)) do begin
writeln('Wrong column number!');
write('Cut after how many character ? ');
readln(len);
end;
end;
procedure screen;
begin
writeln('Cut File v 1.2 - (c) 1991 Francesco Duranti');
if paramcount<>2 then begin
writeln;
writeln('Usage:');
writeln(' CUT [n] [file.ext]');
writeln;
writeln('Cut [file.ext] in two file.');
writeln('Save column 1..n in [file.LFT]');
writeln('Save column n+1..endline in [file.RGT]');
halt(1);
end;
writeln;
end;
procedure read_notab(var i:rftester;var t:string);
var l:integer;
function spacestr(a:integer):string;
var b:string;
i:integer;
begin
for i:=1 to a do b:=b+' ';
spacestr:=b;
end;
function posiz(var a:integer;b,c:string):boolean;
begin
a:=pos(b,c);
posiz:=(a<>0);
end;
begin
i.freadln(t);
while (posiz(l,#9,s)) do
t:=copy(t,1,l)+spacestr(8-(l mod 8))+copy(t,l+1,length(t)-l);
end;
begin
screen;
read_parameter;
while (inpf.RFerror=0) do begin
read_notab(inpf,s);
if len>=length(s) then begin
writeln(outpf1,s);
writeln(outpf2);
end else begin
writeln(outpf1,copy(s,1,len));
writeln(outpf2,copy(s,len+1,length(s)-len));
end;
end;
inpf.done;
close(outpf1);
close(outpf2);
end.